package lists;
use strict;
# written by Anton Sedlak <ased@cce.cz>
our (@ISA, @EXPORT, @EXPORT_OK);
use Exporter ();
@ISA = qw(Exporter);
@EXPORT = qw(list_member list_members list_remove
	     list_add list_del list_and list_diff list_swai list_dup
	     list_serial list_cyclic list_rand list_each list_each_default
	     list_cheese list_even list_odd
	     list_merge list_div list_split list_splitn 
	     list_rotl list_rotr 
	     list_eq list_ne list_empty list_nonempty
	     list_all list_none list_notall list_true list_false
	     list_depend list_reorder);

# find item in list - returns position 0 - count-1 
# or undef if not found
# input: <ref_array>, <item_to_find>
sub list_member {
    my $ref = shift;
    my $item = shift;
    my $count=0;
    for (@$ref) { return $count if $item eq $_; $count++ }
    return undef;
}

# returned list is NOT unique if ref_item is not unique !!!
# input: <ref_array>, <ref_item_to_find>
sub list_members {
    my $ref = shift;
    my $ref_item = shift;
    my (%idx,@ids);
    for(my $id=$#$ref;$id>=0;$id--) { $idx{$ref->[$id]}=$id }
    foreach (@$ref_item) { push @ids,(exists $idx{$_} ? $idx{$_}:undef) }
    return \@ids;
}

# remove items on position given by ref_items
# input: <ref_array>,<ref_to_array of_indexes_to_remove>
sub list_remove {
    my $ref = shift;
    my $ref_items = shift;
    return $ref if ! defined $ref_items;
    my @new;
    my @sorted = sort { $a <=> $b } @$ref_items;
    my $id = 0;	# index to sorted array
    for my $i (0 .. $#$ref) {
	if($sorted[$id] == $i) { $id++ }
	else { push @new, $ref->[$i] }
    }
    return \@new;
}

# we are working with refs !!!
# input: list of array refs union(@1,@2, .. @n)
# output: ref to union list
# 	  ! preserve original order of @1
#	  ! returned list is unique
sub list_add {
    my @refs = @_;
    my (@new,%new);
    for my $ref (@refs) {
	for (@$ref) { push @new,$_ unless $new{$_}++ }
    }
    return \@new;
}
# compute simple difference: diff(@1,@2,.. @N) return all elements
# 	in @1 but not in any other list
# 	! preserve original order of @1
#	! returned elements are unique
sub list_del {
    my @refs = @_;
    my $ref0 = shift @refs;
    my (%seen0,%seen,@new);
    for my $ref (@refs) { @seen{@$ref} = () if $ref } # build lookup table
    for (@$ref0) {
	push(@new, $_) unless $seen0{$_}++ or exists $seen{$_}
    }
    return \@new;
}

# compute intersection: intersect(@1,@2,.. @N) return all elements
# 	common to all @-s 
# 	! preserve original order of @1
#	! returned elements are unique
sub list_and {
    my @refs = @_;
    my $ref0 = shift @refs;
    my (%seen,@new,%seenx);
    for my $ref (@refs) {
	undef %seenx;	# unique hash
	for (@$ref) { $seen{$_}++ unless $seenx{$_}++ }  # build lookup table
    }
    for (@$ref0) {
	undef %seenx;	# unique hash
	push(@new, $_) if !$seenx{$_}++ and exists $seen{$_} and $seen{$_} == scalar @refs;
    }
    return \@new;
}

# compute diff: diff(@1,@2,.. @N) return array of arrays
# 	each with unique items
#      @ret1: contains items of @1 not in any other @
#      @ret2: contains items of @2 not in any other @
# 	! preserve original order of each @
#	! returned elements are unique in each @
sub list_diff {
    my @refs = @_;
    my (%seen,@new,@news,%seenx);
    for my $ref (@refs) {
	undef %seenx;	# unique hash
	for (@$ref) { $seen{$_}++ unless $seenx{$_}++ }  # build lookup table
    }
    for my $ref (@refs) {
	@new=();
	undef %seenx; # unique hash
        for (@$ref) { push(@new, $_) if !$seenx{$_}++ and $seen{$_}==1 }
        push @news,[@new];
    }
    # for only one input array we help - we deref first elem
    return wantarray ? @news : $news[0]; 
}

# compute duplicities: dup(@1,@2,.. @N) return array of arrays
# 	each of items which exists more than once in original @
#      @ret1: contains items of duplicities of @1
#      @ret2: contains items of duplicities of @2
# 	! preserve original order of each @
#	! returned elements are unique in each @
sub list_dup {
    my @refs = @_;
    my (%seen,@new,@news);
    for my $ref (@refs) {
	@new=();
	undef %seen;
        for (@$ref) { push(@new, $_) if 1 == $seen{$_}++  }
        push @news,[@new];
    }
    return wantarray ? @news : $news[0];
}

# swap items: swai(@1,@2,.. @N) return array of arrays
# 	each of two items are swapped in each list
#	# egL @[0]<->@[1],@[2]<->@[3],...
# 	! preserve original order of each pair in @
#	! NOT checked for uniques
#	last odd elemnet is swapped with undef value 
#	  and list is prolonged by 1 item
sub list_swai {
    my @refs = @_;
    my (@new,@news,$i);
    for my $ref (@refs) {
	@new=();
	for($i=0;$i<=$#$ref;$i+=2) { push @new,($ref->[$i+1],$ref->[$i]) } # swap
#	push @new, $ref->[-1] if $i==$#$ref; # last odd element
        push @news,[@new];
    }
    return wantarray ? @news : $news[0];
}

# return function which go cyclic through $from - $to with $step and $start
# example: $each = list_serial(3,0,5,1); and then &$each
sub list_serial {
    my ($start,$from,$to,$step) = @_;
    $step=1 unless defined $step;
    return undef if !defined $to or !defined $from;
    my $id=$start-$step;
    return sub {
	$id+=$step;
	$id=$from if $id > $to or $id < $from;
	return $id;
    }
}

# return function which go cyclic through the given array on each call
# example: $each = list_cyclic(array); and then &$each
sub list_cyclic {
    my $ref = shift;
    my $id=-1;
    return sub {
	$id=0 if ++$id > $#$ref;
	return $ref->[$id];
    }
}

# return function which go through each item of given array on each call
# after that returns undef
# example: $each = list_each(array); and then &$each
sub list_each {
    my $ref = shift;
    my $id=-1;
    return sub {
	return undef if ++$id > $#$ref;
	return $ref->[$id];
    }
}

# return function which go through each item of given array on each call
# after that returns last element as dafault value
# example: $each = list_each_default(array); and then &$each
sub list_each_default {
    my $ref = shift;
    my $id=-1;
    return sub {
	return undef if $#$ref < 0;
	return $ref->[-1] if ++$id > $#$ref;
	return $ref->[$id];
    }
}

# return function which go randomly through the given array on each call
# example: $each = list_rand(array); and then &$each
sub list_rand {
    my $ref = shift;
    return sub {
	my $id=rand $#$ref+1;
	return $ref->[$id];
    }
}
# general function to return even, odd etc. elements of list
# example: list_cheese(array,3,10) : get each 10-th item start at 3-rd item
sub list_cheese {
    my ($ref,$start_item,$delta)=@_;
    my $id=$start_item;
    my @new;
    for(my $id=$start_item;$id<=$#$ref;$id+=$delta) { push @new,$ref->[$id] }
    return \@new;
}
# return each even elemet: this is @[1]-second item, @[3]-forth,... 
sub list_even {
    my $ref = shift;
    return list_cheese($ref,1,2);
}
# return each odd elemet: this is @[0]-first item, @[2]-third,... 
sub list_odd {
    my $ref = shift;
    return list_cheese($ref,0,2);
}

# combine several list into one list
# new list -> first item is first item from first list, second item
# is first item from second list etc...
# list_merge([a,b,c],[1,2,3]) -> [a,1,b,2,c,3]
sub list_merge {
    my @refs = @_;
    my $maxn=-1;
    for my $ref (@refs) { if($#$ref > $maxn) { $maxn=$#$ref } }
    return undef if $maxn < 0;
    my @new;
    for my $j ( 0 .. $maxn ) {
	for my $i ( 0 .. $#refs ) {
	    push @new,$refs[$i][$j];
	}
    }
    return \@new;
}

# div - inverse to merge
# list_div([a,1,b,2],2) -> [a,b],[1,2] - split do even and odd items
sub list_div {
    my $ref = shift;
    my $num = shift;	# split $ref to count lists
    my @news;
    for my $i ( 0 .. $#$ref ) {
      push @{ $news[$i%$num] },$ref->[$i];
    }
    return @news;
}

# split list into several lists, second list specify number of items
# in each returned list
# list_split([1,2,3,4,5,6,7],[2,5]) -> [1,2] [3,4,5,6,7]
# split [1,2,3,4,5,6,7] to 2 list, first will have 2 and second 5 items
sub list_split {
    my $ref = shift;
    my $rc = shift;	# ref to counts
    my @news;
    my $id=0;
    for my $i ( 0 .. $#$rc ) {
	for my $j ( 0 .. $rc->[$i]-1 ) {
	    $news[$i][$j] = $ref->[$id++];
	}
    }
    return @news;
}

# find how to split n-items in k-parts
# list_splitn(11,3) -> [4,4,3] - 11 items are splited to 3 parts
# you can use this array ref as input to list_split
sub list_splitn {
    my $n = shift;
    my $k = shift;
    my $t = int $n / $k;
    my $d = $n % $k;
    my @w = (($t+1) x $d,($t) x ($k-$d));
    return \@w;
}

# rotate left - to new place !!!
sub list_rotl {
    my $ref = shift;
    my $n   = shift || 1;
    my @new;
    for my $i ( 0 .. $#$ref ) {
	$new[$i] = $ref->[ ($i+$n)%($#$ref+1) ];
    }
    return \@new;
}
sub list_rotr {
    return list_rotl($_[0],-($_[1]?$_[1]:1));
}

#---------------------- operators
# list_eq([1,2,3],[1,2,3]) -> true
# else undef -> size diff
#      0     -> not the same items
sub list_eq {
    my $ra = shift;
    my $rb = shift;
    return undef if $#$ra != $#$rb; # not the same size
    for my $i ( 0 .. $#$ra) { return 0 if $ra->[$i] ne $rb->[$i] }
    return 1;
}

sub list_ne {
    my $ra = shift;
    my $rb = shift;
    return ! list_eq($ra,$rb);
}

# How many arrays are empty or undef
sub list_empty { scalar grep { ! $_ or ! scalar @$_ } @_ }
# How many array are non empty and defined
sub list_nonempty { scalar grep { scalar @$_ if $_ } @_ }

# helper function copie of List::Utils
# All arguments are true
sub list_all { $_ || return 0 for @_; 1 }
# All arguments are false
sub list_none { $_ && return 0 for @_; 1 }
# One argument is false
sub list_notall { $_ || return 1 for @_; 0 }
# How many elements are true
sub list_true { scalar grep { $_ } @_ }
# How many elements are false
sub list_false { scalar grep { !$_ } @_ }

#---------------------------------------------------------------
# input hash ref of depenedency tree
# {a=>[b..] b=>[c..] ...} -> [c b a] to get 'a'
#			 first you must do 'c', then 'b' then 'a'
# return 2 ref array:
#   first - order to build dependecy tree from down to up (as make)
#   second - circular depend nodes
sub list_depend {
  my $d = shift;
  my $c; # count hash
  my $b; # back hash
  my @new;
  for my $k (keys %$d) {
    for my $v ( @{ $d->{$k} } ) {
      $c->{$k}++;
      $c->{$v}+=0;
      push @{ $b->{$v} },$k;
    }
  }
 #print Data::Dumper->Dump([$c],[qw(c)]);
  my $prev = 0;
  my $now;
  while($prev != ($now=scalar keys %$c) ) { #  end on not changing 
    for my $k (keys %$c) {
      if($c->{$k} == 0) {
        push @new, $k;
	for my $v ( @{ $b->{$k} } ) {  $c->{$v}-- }
	delete $c->{$k};
      }
    }
    $prev=$now;
  }
  my @circ = keys %$c;
  return (\@new,\@circ);
}

# change order of lists
# - first list specify new positions [0..$#] ! 0means first item
# - other lists are reorder as specified in first elements
# return ([unique_order_lists],@reordered lists)

# - some inteligent is done with order specification: 
#   if new_pos < 0 -> new_pos=0
#   if new_pos > $# -> new_pos=$#
#   if duplicate position found -> first free place is used
#   if new_pos = undef -> new_pos is first free place after
#                         all items were placed
sub list_reorder {
    my $ref = shift;
    my @refs = @_;
    my (%seen,@new,$v,$i);

    my $freepos = sub { # requires $v,%seen,$ref
        my $cyc = list_serial($v,0,$#$ref); # go through $v,$v+1,..$v-1
	my $new_v;
        for(0..$#$ref) {
	    $new_v = &$cyc;
	    return $new_v unless exists $seen{$new_v};
	}
	return undef;
    };

    for $i ( 0 .. $#$ref ) {
	$v = $ref->[$i];
	next unless defined $v;
	$v = $#$ref if $v > $#$ref;
	$v = 0    if $v < 0;
        $v = &$freepos;
        $new[$i] = $v;  $seen{$v}++;
    }
    for $i ( 0 .. $#$ref ) {
	$v = $ref->[$i];
	next if defined $v;
	$v=0;
        $v = &$freepos;
        $new[$i] = $v;  $seen{$v}++;
    }
    my @news; push @news,\@new;
    # change order of given lists
    for my $r (@refs) {
	my @n;
	for $i (0 .. $#new) {
    	    $n[$new[$i]] = $r->[$i];
	}
	push @news,\@n;
    }
    return @news;
}

1;

__END__
# author: Anton Sedlak 2003 <ased@cce.cz>
# improvements: Jan Krivonoska <jkri@cce.cz>
